home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / packet / terminal / top_152 / src152.exe / rar / TOPCOL.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-16  |  5KB  |  188 lines

  1. {┌─────────────────────────────────────────────────────────────────────────┐}
  2. {│                                                                         │}
  3. {│                              T. O. P.                                   │}
  4. {│                                                                         │}
  5. {│                        (T)he  (O)ther  (P)acket                         │}
  6. {│                                                                         │}
  7. {│ T O P C O L . P A S                                                     │}
  8. {│                                                                         │}
  9. {│                                                                         │}
  10. {│ Routinen für die Farbeinstellung                                        │}
  11. {└─────────────────────────────────────────────────────────────────────────┘}
  12.  
  13.  
  14. Procedure Color_Einstellung;
  15. Const xb   = 5;
  16.       ya   = 5;
  17.       lp   = '▓' + Chr(16);
  18.       rp   = Chr(17) + '▓';
  19.       Cstr = 'Color-Nr = ';
  20.       Zstr = 'Zeile: ';
  21.  
  22. Type  ColPtr = Array[1..maxAttr] of String[70];
  23.  
  24. Var   Old_Attrib,
  25.       i,yb,ym,yl : Byte;
  26.       ch         : Char;
  27.       KC         : Sondertaste;
  28.       Merker,
  29.       Flag       : Boolean;
  30.       Hstr       : String[3];
  31.       ADoc       : ^ColPtr;
  32.  
  33.   Procedure Attrib_Read(Art : Byte);
  34.   Var  i,i1 : Byte;
  35.   Begin
  36.     FiResult := ResetTxt(G^.TFile);
  37.     i1 := ya;
  38.     for i := 1 to maxAttr do
  39.     begin
  40.       Readln(G^.TFile,G^.DZeile);
  41.       ADoc^[i] := EFillStr(70,B1,B2 + RestStr(G^.DZeile));
  42.       if Art = 1 then Attrib[i] := Byte(str_int(CutStr(G^.DZeile)));
  43.       if i1 <= ym then
  44.       begin
  45.         WriteRam(xb,i1,Attrib[i],0,ADoc^[i]);
  46.         inc(i1);
  47.       end;
  48.     end;
  49.     Readln(G^.TFile,G^.DZeile);
  50.     HighCol := Byte(str_int(copy(G^.DZeile,1,1))) = 1;
  51.     ColorItensity(HighCol);
  52.     FiResult := CloseTxt(G^.TFile);
  53.   End;
  54.  
  55.   Procedure KillPfeil;
  56.   Begin
  57.     WriteRam(xb-2,yb,15,0,B2);
  58.     WriteRam(xb+70,yb,15,0,B2);
  59.   End;
  60.  
  61. Begin
  62.   Assign(G^.TFile,Sys1Pfad + AttrDatei + LngExt);
  63.   flag := false;
  64.   Merker := true;
  65.   Neu_Bild;
  66.   Teil_Bild_Loesch(1,maxZ,0);
  67.   GetMem(ADoc,SizeOf(ADoc^));
  68.   FillChar(ADoc^,SizeOf(ADoc^),0);
  69.  
  70.   i := length(InfoZeile(33));
  71.   WriteRam(40-i div 2,1,15,0,InfoZeile(33));
  72.   WriteRam(40-i div 2,2,15,0,ConstStr('-',i));
  73.  
  74.   ym := maxZ - 5;
  75.   yb := ya;
  76.   yl := 1;
  77.  
  78.   Attrib_Read(0);
  79.  
  80.   WriteRam(xb,maxZ-1,15,0,InfoZeile(22));
  81.   WriteRam(xb,maxZ,15,0,InfoZeile(23));
  82.  
  83.   Repeat
  84.     if Merker then Old_Attrib := Attrib[yl];
  85.     WriteRam(xb,maxZ-3,15,0,Cstr +
  86.       EFillStr(4,B1,int_str(Attrib[yl])) +
  87.       EFillStr(8,B1,'(' + int_str(Old_Attrib) + ')') +
  88.       EFillStr(length(Zstr)+3,B1,Zstr + int_str(yl)));
  89.     WriteRam(xb,yb,Attrib[yl],0,ADoc^[yl]);
  90.     WriteRam(xb-2,yb,15,0,lp);
  91.     WriteRam(xb+70,yb,15,0,rp);
  92.  
  93.     _ReadKey(KC,ch);
  94.     case KC of
  95.      _Ret,
  96.      _Esc :;
  97.  
  98.     _AltH : TOP_Help(G^.OHelp[6]);
  99.  
  100.       _Up : if (yl > 1) then
  101.             begin
  102.               KillPfeil;
  103.               dec(yl);
  104.               if yb > ya then dec(yb) else Scroll(Dn,0,ya,ym);
  105.             end else Alarm;
  106.  
  107.       _Dn : if (yl < maxAttr) then
  108.             begin
  109.               KillPfeil;
  110.               inc(yl);
  111.               if yb < ym then inc(yb) else Scroll(Up,0,ya,ym);
  112.             end else Alarm;
  113.  
  114.       _F1 : begin
  115.               yl := 1;
  116.               yb := ya;
  117.               Teil_Bild_Loesch(ya,ym,0);
  118.               Attrib_Read(1);
  119.               Flag := false;
  120.             end;
  121.  
  122.    _Right : if Attrib[yl] < 255 then inc(Attrib[yl]);
  123.  
  124.    _Left  : if Attrib[yl] > 0   then dec(Attrib[yl]);
  125.  
  126.       _F5 : if Attrib[yl] >= 16 then dec(Attrib[yl],16);
  127.  
  128.       _F6 : if Attrib[yl] <= 239 then inc(Attrib[yl],16);
  129.  
  130.       _F7 : begin
  131.               dec(Attrib[yl]);
  132.               if (Attrib[yl]+1) mod 16 = 0 then inc(Attrib[yl],16);
  133.             end;
  134.  
  135.       _F8 : begin
  136.               inc(Attrib[yl]);
  137.               if Attrib[yl] mod 16 = 0 then dec(Attrib[yl],16);
  138.             end;
  139.  
  140.       _F9 : begin
  141.               HighCol := not HighCol;
  142.               ColorItensity(HighCol);
  143.             end;
  144.  
  145.      _F10 : if Attrib[yl] > 127 then Attrib[yl] := Attrib[yl] - 128
  146.                                 else Attrib[yl] := Attrib[yl] + 128;
  147.  
  148.   _Andere : if ch in ['0'..'9'] then
  149.             begin
  150.               Hstr := ch;
  151.               GetString(Hstr,15,3,xb+length(Cstr),maxZ-3,KC,3,Ins);
  152.               if KC <> _Esc then
  153.               begin
  154.                 Attrib[yl] := Byte(str_int(Hstr));
  155.                 Flag := true;
  156.               end;
  157.               KC := _Nix;
  158.             end else Alarm;
  159.        else Alarm;
  160.     end;
  161.  
  162.     Merker := not(KC in [_F5.._F10,_Right,_Left]);
  163.     if (KC in [_F5.._F10,_Right,_Left]) then Flag := true;
  164.   Until KC in [_Esc,_Ret];
  165.  
  166.   if Flag then
  167.   begin
  168.     Teil_Bild_Loesch(ym+1,maxZ,0);
  169.     WriteRam(xb,maxZ-1,15,0,InfoZeile(34));
  170.     _ReadKey(KC,ch);
  171.     
  172.     if (UpCase(ch) in YesMenge) or (KC in [_Ret]) then
  173.     begin
  174.       FiResult := RewriteTxt(G^.TFile);
  175.       for i := 1 to maxAttr do
  176.         Writeln(G^.TFile,EFillStr(3,B1,int_str(Attrib[i])) + ADoc^[i]);
  177.       if HighCol then i := 1
  178.                  else i := 0;
  179.       Writeln(G^.TFile,i);
  180.       FiResult := CloseTxt(G^.TFile);
  181.     end;
  182.     Cursor_aus;
  183.   end;
  184.  
  185.   FreeMem(ADoc,SizeOf(ADoc^));
  186.   Neu_Bild;
  187. End;
  188.